          SUBROUTINE (OID,GEN,LDID,CHK.FUT,REDISP,VIEW.ONLY,DFLT.TYP,OQTY)
** Version# 177.0001[2] - 03/30/2017 - 02:37pm - TSMITH - eclipse
*** V177.0001 Change - Custom Coding . - 03/30/2017 - TSMITH - eclipse

*** Subroutine - SOE.RETURN.CHECK
*-------------------------------------------------------------------------*
*** This routine prompts user for Return information, which is invoked
*** when a negative quantity is entered in OE.
***
*** Note: this program has been implemented in solar eclipse but the
*** updated/init routines haven't been integrated into this version
*** so that regression tests can be made.
***
*** Note:  Though the user can input the return description in sizes of 60
*** characters across, it will only ever be stored/redisplayed with a
*** maximum width of 35 characters.  If we were to change the size of the
*** input field, it would then necesitate a screen re-sizeing, which would
*** create havoc for support after it got to sites...
*-------------------------------------------------------------------------*
*** OID         - Order Id where this came from                     (IN)
*** GEN         - Generation                                        (IN)
*** LDID        - The LDID list from the order (OID)                (IN)
*** CHK.FUT     - Flag Indicating wheter Future Shipments should    (IN)
***                 be included.
*** REDISP      - Flag set in prog indicating a redisplay is needed (OUT)
*** VIEW.ONLY   - View Only flag sent to program                    (IN)
*** DFLT.TYP    - The Default Return Type                           (IN)
*** OQTY        - Passed in if order qty changes                    (IN)
*-------------------------------------------------------------------------*
*** Common Variables Used:
*** STK.TYPES.AVL$
*-------------------------------------------------------------------------*
*** Phantom Friendly: No
*** Java Friendly: No
*-------------------------------------------------------------------------*

          * Used to include dim sizes for work arrays
          $INCLUDE CC DIM.EQUATES

          REDISP           = NO
          ORIGINAL.COMMENT = YES
          INIT.ORIG.ORD    = ""
          INIT.ORIG.OID    = ''
          ORIG.TAX         = ''
          USE.ORIG.TAX     = ''
          OOID             = ""
          ORIG.TYP         = FIELD(LD(44),'.',4)
          TYP.CHG          = NO
          MODE             = OID[1,1]
          COPY.LEDCC      = NO
          CLEAR.LEDCC     = NO
          BR = LED(2)<1,GEN,1>

          UT.OPEN.FILE 'LEDGER.CC',LEDCCFILE,LCC.ERR,YES

          NO.IN.OE = OID<1,2>
          OID      = OID<1,1>

          CTRB.ID = "REQ.RET.CODE~":BR
          READV REQ.CD FROM CTRBFILE,CTRB.ID,1 ELSE REQ.CD = 0
          REQ.CD += 0

          STK.BR  = LED(2)<1,GEN,2>
          CTRB.ID = "RETURN.LOCATION.COPY~":STK.BR
          READV RET.LOC.COPY FROM CTRBFILE,CTRB.ID,1 ELSE RET.LOC.COPY=''
          RET.LOC.PRI = ''

          IF JOHNSTONE.SITE$ THEN
             * Determine site by site whether to use Johnstone Warranty
             CTRL.ID = 'JS.WARR.ACTIVE'
             READ JS.ACTIVE FROM CTRLFILE,CTRL.ID ELSE JS.ACTIVE = ''
          END ELSE
             JS.ACTIVE = ''
          END

          * Get the QSIGN
          OE.GET.QSIGN QSIGN,OID,GEN

          CTRB.ID = "RETURN.LOCATION.DEFAULT~":STK.BR
          READV RET.LOC.DFLT FROM CTRBFILE,CTRB.ID,1 ELSE RET.LOC.DFLT=''

          CTRB.ID = "RETURN.LOCATION.SDEFAULT~":STK.BR
          READV RET.LOC.SDFLT FROM CTRBFILE,CTRB.ID,1 ELSE
             RET.LOC.SDFLT = ''
          END

          * Check to see if the Inventory History screen should open
          * if the user doesn't enter the original order manually.
          READV CTO FROM CTRLFILE,"SOE.RETURN.INV.HIST",1 ELSE CTO = ""

          * Parameters for requiring an order, preventing duplicate
          * returns.
          REQUIRE.ORIG    = NO
          STOP.DUP.RETURN = NO

          * For Sales Orders, read in the parameters from the control
          * record.
          IF (MODE = "S") THEN
             CTRL.ID = "SOE.RETURN.SETUP"
             READV RET.PARMS FROM CTRLFILE,CTRL.ID,1 ELSE RET.PARMS = ""
             REQUIRE.ORIG    = RET.PARMS<1,1,1>
             STOP.DUP.RETURN = RET.PARMS<1,1,2>

             * If we are stop duplicate returns, we MUST require an
             * original order.
             IF STOP.DUP.RETURN THEN REQUIRE.ORIG = YES

             * If we are going to require the original order be entered,
             * then force them to check Inventory History.
             IF REQUIRE.ORIG THEN CTO = YES
          END

          * If dimed array is going to be used for reset with MAT = MAT
          * then dim size must be the same or the remaining fields/array
          * will not be reset correctly, due to MAT = MAT only overlaying
          * defined dim size.
          * DIM sizes defined in CC DIM.EQUATES
          DIM LD2(DIM.LD.SIZE%), LED2(DIM.LED.SIZE%)
          DIM LD3(DIM.LD.SIZE%), OLD.LD2(DIM.LD.SIZE%)
          DIM SV.CURR.LD(DIM.LD.SIZE%), SV.OLD.LD(DIM.LD.SIZE%)

          READ RSTK.PN FROM CTRLFILE,'SOE.RESTOCK.PRD' ELSE RSTK.PN =''

          SER.NUM = ''
          IF CHK.FUT THEN
             PRD.RETURN.FUTURE.LED LED(2)<1,GEN,2>,LD(1),LED(1)<1,GEN>,OID,GEN
          END
          IF F12 THEN F12 = NO; QUIT = NO; RETURN

          SCREEN

          BUYLINE.BR.GET.VAL LED(2)<1,GEN,2>,PRD(12),18,RMSG
          RMSG<1,-1> = PLNE(15)
          MATBUILD SAVE.LD     FROM LD

          *** Initialize the variables.
          READV PDESC FROM PRDFILE,LD(1),1 ELSE PDESC = ''
          CONVERT VM TO ' ' IN PDESC
          LDATA    = ''
          ORIG.LDATA = ''
          ORIG.OID = ''
          IF FIELD(LD(44),'.',1) # '' THEN
             INIT.ORIG.ORD = LD(44)
             ORIG.OID = FIELD(LD(44),'.',1):'.':FIELD(LD(44),'.',2) "R%3"
             INIT.ORIG.OID = ORIG.OID
          END

          TOID    = FIELD(LD(44),'.',1)
          TINVN   = FIELD(LD(44),'.',2)
          TLDID   = FIELD(LD(44),'.',3)
          TYP     = FIELD(LD(44),'.',4)
          TLOC    = FIELD(LD(44),'.',5)
          COMMENT = LD(45)
          RCODE   = LD(46)
          RPRC    = LD(99)<1,1>      ;* Restocking Fee Price Percentage

          * If this is a direct then the typ needs to be changed to 'D'
          * This is for coming back into the screen from the schedule
          * screen when the user changes the order to a direct after the
          * fact.
          IF LED(33)<1,GEN> THEN
             TYP = 'D'
          END

          * Don't change the VM to ' '.  Just fold the existing return
          * comment within it's existing VM's...  Otherwise, multi-line,
          * short strings all get concatenated.
          FOLD COMMENT,'35',COMMENT
          CTRB.ID = "RETURN.GOODS.TYPE~":LED(2)<1,GEN,2>
          READV STK.TYP FROM CTRBFILE,CTRB.ID,1 ELSE STK.TYP=''
          STK.TYPS = ',R-Review,F-DeFective,S-Stock,O-Overship'
          TST.TYPS = 'S,F,O,R'

          SOE.RETURN.CHECK.API OID,GEN,TYP,STK.TYP,TST.TYPS,STK.TYPS

          IF LED(33)<1,GEN> THEN
             STK.TYP  = 'D'
             STK.TYPS = 'D-Direct'
             TST.TYPS = 'D'
          END

          CNCSGN   = ''
          IF LED(110)<1,1> = 'B' THEN
             STK.TYP  = 'C'
             STK.TYPS = 'C-CnCsgn'
             TST.TYPS = 'C':LED(5)<1,GEN>
             CNCSGN   = TST.TYPS
          END

          * The first two case statements are attempting to deal with the
          * scenario that the user has changed the order from a direct/
          * consignment bill to a regular order and we are displaying the
          * screen for them to review the return information.  The TYP
          * passed in at that point is stil the 'D'/'C'.  This logic
          * will recognize that the 'D'/'C' is no longer valid and
          * populate the STK.TYP with the DFLT.TYP.
          BEGIN CASE
          CASE TYP = 'D' AND LED(33)<1,GEN>      ;* Direct
             STK.TYP = TYP
          CASE TYP = 'C' AND LED(110)<1,1> = 'B' ;* Consignment Bill
             STK.TYP = TYP
          CASE TYP AND TYP # 'C' AND TYP # 'D'
             STK.TYP = TYP
          CASE OTHERWISE
             * If we made it here with a direct or consignment type, then
             * TYP is invalid and needs to be set properly.  This is
             * accomplished by setting TYP.CHG.
             IF TYP = 'D' OR TYP = 'C' THEN
                TYP.CHG = YES
             END

             IF ASSIGNED(DFLT.TYP) THEN
                IF DFLT.TYP # '' THEN STK.TYP = DFLT.TYP
             END
          END CASE

          *** This was added to prevent orig oid from being corrupted if
          *** you came into this screen and immediately escaped out
          GOSUB CHK.OID

          GOSUB DISPLAY
          GOSUB DISPLAY.RTN.POLICY
*-------------------------------------------------------------------------*
          MENU.LOAD  2,19, 8,5,'H'
          MENU.LOAD 13,19,10,1,'S'
          MENU.LOAD 26,19, 8,1,'W'
          MENU.LOAD 37,19, 8,5,'C'
          MENU.LOAD 48,19,13,1,'R'
*-------------------------------------------------------------------------*
          IF VIEW.ONLY THEN
             PRINT @(2,0):BLINK$:'View Only':NORM$
             IF MESSG # '' THEN
IN$$8:          INPNO A,,,0
             END
VIEWONLY:    GOTO IN.MSG
             IF QUIT THEN GOTO FINISH
             GOTO VIEWONLY
          END
*-------------------------------------------------------------------------*
IN.CHK:   *
          SV.ORIG.OID = ORIG.OID
IN$$10:   INP ORIG.OID,25,1,14,'MCU'
          IF QUIT THEN GOTO FILEIT
          IF CHANGED THEN
             * Check original order locks.
             GOSUB CHK.ORIG.LOCKS
             IF ORIG.LOCKED THEN
                ORIG.OID = SV.ORIG.OID
                PRINT @(25,1):ORIG.OID "L#14"
                GOTO IN.CHK
             END
             * Check if item is on the original order.
             GOSUB CHK.OID
          END
          IF STK.TYP # 'D' THEN
             ON MOVE+1 GOTO IN.CHK, IN.CHK, IN.CHK, IN.CHK, IN.TYP, IN.TYP
          END ELSE
             ON MOVE+1 GOTO IN.CHK, IN.CHK, IN.CHK, IN.CHK, IN.CODE, IN.CODE
          END
*-------------------------------------------------------------------------*
IN.TYP:   *
IN$$12:   INP STK.TYP,25,2,1,'MCU',V_'D:':STK.TYPS
          IF CNCSGN THEN STK.TYP = CNCSGN
          IF CHANGED THEN TYP.CHG = YES
          IF QUIT THEN GOTO FILEIT
          ON MOVE+1 GOTO IN.TYP,IN.TYP,IN.CHK,IN.TYP,IN.CODE,IN.CODE
*-------------------------------------------------------------------------*
IN.CODE:  *
IN$$14:   INP RCODE,25,3,30,V_'C:VALID.RCODES'

          IF CHANGED THEN
             * For Johnstone when user keys in Warranty go directly
             * to Johnstone Warranty Form.
             IF JOHNSTONE.SITE$ AND UPCASE(RCODE) = 'WARRANTY' THEN
             GOSUB WRRTY
             END
          END

          IF QUIT THEN GOTO FILEIT
          IF STK.TYP # 'D' THEN
             ON MOVE+1 GOTO IN.CODE,IN.CODE,IN.TYP,IN.CODE
          END ELSE
             ON MOVE+1 GOTO IN.CODE,IN.CODE,IN.CHK,IN.CODE
          END
*-------------------------------------------------------------------------*
*** Input restocking price percentage for return items
IN.RPRC:
IN$$11:   INP RPRC,25,4,3,'R'
          IF QUIT THEN GOTO FILEIT
          ON MOVE+1 GOTO IN.RPRC, IN.RPRC, IN.CODE, IN.RPRC
*-------------------------------------------------------------------------*
IN.MSG:   *
          SVD.COMMENT = COMMENT
IN$$6:    INPWP COMMENT,1,8,60,10,999,'0100'

          *** This is a special view only modification to the inpwp
          *** so that the user can still scroll through all of the
          *** comments, but cannot make changes to these comments..

          IF CHANGED AND VIEW.ONLY THEN
             ERR.MESS 2,1,BELL:'View Only - No Changes Saved'
IN$$7:       INP A,,,0
             COMMENT = SVD.COMMENT
             GOSUB DISPLAY
          END

          IF QUIT THEN GOTO FILEIT
          IF VIEW.ONLY THEN
             ON MOVE+1 GOTO IN.MSG,IN.MSG,IN.MSG,IN.MSG,IN.MSG,IN.MSG
          END ELSE
             ON MOVE+1 GOTO IN.MSG,IN.MSG,IN.RPRC,IN.MSG,IN.MSG,IN.MSG
          END
*-------------------------------------------------------------------------*
SUBS:     ON OPTION GOTO INV.HIST,SER.SEARCH,WRRTY,SCMTS,RPOLICY
*-------------------------------------------------------------------------*
CHK.OID:  * Make sure they have put in a valid order. Hardcode '8'
          * since they may have a combination of 8 and 10 digit orders
          IF LEN(ORIG.OID) < 8 OR ORIG.OID[1,1] # 'S' THEN
             ORIG.OID = ''
          END
          MAT LED2 = MAT LED
          MAT LD3  = MAT LD

          SOID = FIELD(ORIG.OID,'.',1)
          INVN = FIELD(ORIG.OID,'.',2)

          *** Only want to look at  the gens which have been shipped.
          IF SOID # '' THEN
             MATREAD LED FROM LEDFILE,SOID ELSE
                SOID = ''; INVN = ''; ORIG.OID = ''
             END

             *** If they gave us an invoice number use it, otherwise
             *** make them choose 1.
             IF INVN # '' AND INVN+0 # 0THEN
                INVN = INVN+0
                LOCATE INVN IN LED(8)<1> SETTING OGN THEN
                   ORIG.OID = SOID:'.':INVN "R%3"
                END ELSE
                   ORIG.OID = ''
                END
             END ELSE
                IDS     = ''
                INVN.CT = 0
                OGN.CT  = DCOUNT(LED(8)<1>,VM)
                FOR OGN = 1 TO OGN.CT
                   IF LED(8)<1,OGN> THEN
                      INVN.CT  += 1
                      IDS<1,-1> = SOID:'.':LED(8)<1,OGN> "R%3"
                   END
                NEXT OGN
                MENU.TABLE OOID,,,1,INVN.CT,14,,,IDS,'Invoices'
                INVN = FIELD(OOID,'.',2)+0
                LOCATE INVN IN LED(8)<1> SETTING OGN ELSE OGN = 1
                ORIG.OID = OOID
             END
          END

          *** Make sure this PN is on the orig order and get the LDID.
          SV.LDID = LDID
          IF ORIG.OID # '' THEN
             GOT.GN = NO
             LD.CT = DCOUNT(LED(48)<1,OGN>,SVM)
             FOR LNUM = 1 TO LD.CT
                LDID = LED(48)<1,OGN,LNUM>
                LD.GET LDID
                IF LD(1) # LD3(1) THEN
                   LOCATE LD3(1) IN LD(31)<1> SETTING POS THEN
                      GOT.GN = YES
                      EXIT
                   END
                END ELSE
                   GOT.GN = YES
                   EXIT
                END
             NEXT LNUM
             IF GOT.GN THEN
                LDATA = ''
                LDATA = LD3(1):'~':LED(2)<1,OGN,2>:'~':LED(9)<1,OGN>:'~'
                LDATA := SOID:'~':INVN:'~':LDID
             END ELSE
                LDATA = ''
                ERR.MESS 25,4,BELL:'Invalid Invoice Number!'
IN$$15:         INP A,0,4,0
             END
          END ELSE
             LDATA = ''
          END

          ORIG.LDATA = LDATA

          LDID = SV.LDID

          MAT LED = MAT LED2
          MAT LD  = MAT LD3
          GOSUB GET.LINFO
          GOSUB DISPLAY
          RETURN
*-------------------------------------------------------------------------*
INV.HIST: * Check the inventory history ledger.
          SV.LDATA = LDATA
          LDATA    = '1'
          SER.NUM  = ''
          READV CHK.HIST FROM CTRLFILE,'OE.SEL.RETURN.HIST',1 ELSE CHK.HIST = ''
          IF CHK.HIST[1,1] = 'C' THEN
             CUS.INV.HISTORY LED(1)<1,GEN>,LED(2)<1,GEN,2>,DATE(),,LD(1),LDATA
          END ELSE
             INV.HISTORY.LEDGER LD(1),DATE(),LED(2)<1,GEN,2>,LED(1)<1,GEN>,2,LDATA,LED(5)<1,GEN>
          END
          IF F12 THEN
             LDATA = SV.LDATA
          END ELSE
             * If either the initial original order or the original
             * order is locked restore ldata. Otherwise get the ldata
             * for the selected original order and display it.
             ORIG.OID = FIELD(LDATA,'~',4)
             GOSUB CHK.ORIG.LOCKS
             IF ORIG.LOCKED THEN
                LDATA = SV.LDATA
             END ELSE
                GOSUB GET.LINFO
                GOSUB DISPLAY
             END
          END
          F12 = NO; QUIT = NO
          RETURN
*-------------------------------------------------------------------------*
SER.SEARCH:*** Search for specific serial number for this product
          SV.LDATA = LDATA
          LDATA = '1'
          SPASS = LED(1)<1,GEN>:VM:LD(1)
          PROD.SERIAL.SEARCH SPASS
          LDATA   = SPASS<1,3>
          SER.NUM = SPASS<1,4>
          IF F12 THEN
             LDATA = SV.LDATA
          END ELSE
             * If either the initial original order or the original
             * order is locked restore ldata. Otherwise get the ldata
             * for the selected original order and display it.
             ORIG.OID = FIELD(LDATA,'~',4)
             GOSUB CHK.ORIG.LOCKS
             IF ORIG.LOCKED THEN
                LDATA = SV.LDATA
             END ELSE
                GOSUB GET.LINFO
                GOSUB DISPLAY
             END
          END
          F12 = NO; QUIT = NO
          RETURN
*-------------------------------------------------------------------------*
WRRTY:    * display the warranty info scrren.

          IF JOHNSTONE.SITE$ AND JS.ACTIVE THEN

             JS.WARRANTY.ENTRY OID,GEN,LDID,ORIG.LDATA,ORIG.OID

             * Check if they aborted out - this will remove item
             * from order when called from OE.ACTION.DISPLAY
             IF LD(7)<1,GEN> = '' THEN
                RETURN TO FINISH
             END
          END ELSE

             *Grab the Form ID.
             PRD.CHK.WRNTY.SCREEN LED(2)<1,GEN,2>,PRD(12),LDID,OID,FORM.ID

             PASSER = OID:'.':LDID
             FORM.RUN FORM.ID,PASSER
          END
          RETURN
*-------------------------------------------------------------------------*
SCMTS:    * display the standard comments.
          READ SCMTS FROM CTRLFILE,'RET.STANDARD.COMMENTS' ELSE PRINT BELL:; RETURN
          MENU.TABLE SCMT,,,1,10,70,,,SCMTS,'Standard Comments'
          IF SCMT THEN
             FOLD SCMT,60,ADDSTR
             COMMENT = TRIM(TRIM(COMMENT),VM,'T')
             COMMENT<1,-1> = ADDSTR
          END
          GOSUB DISPLAY
          RETURN
*-------------------------------------------------------------------------*
RPOLICY:  * Display the return policy message.
          BUYLINE.BR.GET.VAL LED(2)<1,GEN,2>,PRD(12),18,RMSG
          RMSG<1,-1> = PLNE(15)
IN$$4:    INP.WINDOW RMSG,,,60,10,999,'Return Policy*VIEW ONLY*'
          RETURN
*-------------------------------------------------------------------------*
GET.LINFO:IF VIEW.ONLY THEN RETURN
          TOID  = FIELD(LDATA,'~',4)
          TINVN = FIELD(LDATA,'~',5)
          TLDID = FIELD(LDATA,'~',6)

          TLOC  = FIELD(LDATA,'~',8)
          TLOC  = FIELD(TLOC ,'^',1)
          TLOC  = FIELD(TLOC ,'|',1)

          *** See what entity orignal order is from
          MATBUILD SV.LED FROM LED
          ORIG.BT = ''

          IF NOT(TOID) THEN GOTO SKIPCK
          MATREAD LED FROM LEDFILE,TOID ELSE GOTO SKIPCK
          LOCATE TINVN IN LED(8)<1> SETTING TEMP.GEN ELSE GOTO SKIPCK
          ORIG.BT     = LED( 1)<1,TEMP.GEN>
          ORIG.CUS.PO = LED(13)<1,TEMP.GEN>
          TCURR       = RAISE(LED(92)<1,TEMP.GEN>)
          ORIG.TAX    = LED(79)<1,TEMP.GEN>
          SOE.RETURN.CHK.TAX.JUR USE.ORIG.TAX,ORIG.TAX

          *** Restore origial ledger
SKIPCK:   MATPARSE LED FROM SV.LED

          *** Check to see if orignal order is from same BT entity as ret.
          BT = LED(1)<1,GEN>
          IF ORIG.BT AND ORIG.BT # BT THEN
             LDATA = ''
             TOID = ''
             TINVN = ''
             TLDID = ''
             TLOC  = ''
             TCURR = ''
             ORIG.OID = ''
             PRINT @(25,1):SPACE(12)
             MESS 1,10,BELL:'Cannot select an Order from Another Entity!! Press <Enter>'
IN$$9:       INP A,,,0
             RETURN
          END

          LD.READ MAT LD2,TOID,TLDID
          READV INVNS FROM LEDFILE,TOID,8 ELSE INVNS = ''
          LOCATE TINVN IN INVNS<1> SETTING GN ELSE GN = 1

          IF LD2(4) > 0 THEN
             LDATA = ''
             TOID = ''
             TINVN = ''
             TLDID = ''
             TLOC  = ''
             TCURR = ''
             ORIG.OID = ''
             PRINT @(25,1):SPACE(12)
             MESS 10,10,BELL:'Cannot select a Credit Sale!! Press <Enter>'
IN$$3:       INP A,,,0
          END

          IF TOID # '' THEN
             ORIG.OID = TOID:'.':TINVN "R%3"
          END

          RETURN
*-------------------------------------------------------------------------*
UPD.WRTR: * Check to update the writer to writer of original order
*** This will check to see if the Writer of the original order should be
*** used on the Return Order. If it is to be used, put it in LED(73)
          READV RETWTR FROM CTRLFILE,'OE.RETURN.WRITER',1 ELSE RETWTR=''
          IF RETWTR THEN
             IF TOID # '' THEN
                READV OWRITER FROM LEDFILE,TOID,73 ELSE OWRITER = ''
                READV TINVNS FROM LEDFILE,TOID,8 ELSE TINVNS = ''
                LOCATE TINVN IN TINVNS<1> SETTING POS THEN
                   OE.ADD.COMMENT OID,GEN,'Control setting changed writer from : ':LED(73)<1,GEN>:' to : ':OWRITER<1,POS>:' from original sale ':TOID
                   LED(73)<1,GEN> = OWRITER<1,POS>
                END
             END
          END

          RETURN
*-------------------------------------------------------------------------*
UPD.SRC: * Update source to original source
             IF TOID # '' THEN
                READV OSOURCE FROM LEDFILE,TOID,3 ELSE OWRITER = ''
                READV TINVNS FROM LEDFILE,TOID,8 ELSE TINVNS = ''
                LOCATE TINVN IN TINVNS<1> SETTING POS THEN
                   OE.ADD.COMMENT OID,GEN,'Changed sales source from : ':LED(3)<1,GEN>:' to : ':OSOURCE<1,POS>:' from original sale ':TOID
                   LED(3)<1,GEN> = OSOURCE<1,POS>
                END
             END


            RETURN
*-------------------------------------------------------------------------*
DISPLAY:  * display the screen.

          PRINT @(25,1):ORIG.OID        "L#14"
          PRINT @(25,2):STK.TYP         "L#1"
          PRINT @(25,3):RCODE           "L#30"
          PRINT @(25,4):RPRC            "R#3"

          MSG.CT = DCOUNT(COMMENT<1>,VM)
          IF MSG.CT > 10 THEN MSG.CT = 10
          FOR JT = 1 TO MSG.CT
             PRINT @(1,7+JT):COMMENT<1,JT> "L#60"
          NEXT JT
          IF LD(1)#'' AND NUM(LD(1)) THEN
             READV PN.DESC FROM PRDFILE,LD(1),1 ELSE PN.DESC = ''
             CONVERT VM TO ' ' IN PN.DESC
             CONVERT SVM TO ' ' IN PN.DESC
             PRINT @(17,6):PN.DESC "L#40"
          END
          RETURN
*-------------------------------------------------------------------------*
DISPLAY.RTN.POLICY: *** Display the return policy
          MESSG = ''
          PLAY.TUNE '$RETURN.POLICY'
          MCT  = DCOUNT(RMSG,VM)
          IF MCT > 10 THEN MCT = 10
          IF MCT+0 > 0 THEN
             FOR J = 1 TO MCT
                IF TRIM(RMSG<1,J>) THEN
                   MESSG<-1> = RMSG<1,J> "L#60"
                END
             NEXT J
             IF MESSG # '' THEN
                MESS 1,6,MESSG
             END
          END

          RETURN
*-------------------------------------------------------------------------*
GET.LOT.RET.QTY:

          ORIG.QTY = -(LD2(4))
          OLD.LOCS = LD2(7)
          ORIG.LD5 = LD2(5)
          ORIG.LD6 = LD2(6)

          SOE.LOT.RETURN.CHECK OID,GEN,ORIG.QTY,OLD.LOCS,ORIG.LD5,ORIG.LD6,LOC.IDS,RET.QTYS
          RETURN
*-------------------------------------------------------------------------*
CHK.CURR: *** Check to see if we need to modify the values being stored
          *** because of changes in currency rates.

          *** If either the source or destination orders are in base, then
          *** just move over base...
          IF NCURR<1,1> = '' OR TCURR<1,1> = '' THEN RETURN

          *** When we are dealing with non-null currencies, there are
          *** only two cases we need to deal with...  1) CurrA -> CurrA,
          *** 2) CurrA -> CurrB.

          *** Case 1.  CurrA -> CurrA.
          BOT = OCONV(TCURR<1,2>,'MR4')
          TOP = OCONV(NCURR<1,2>,'MR4')

          *** Case 2.  CurrA -> CurrB.
          IF NCURR<1,1> # TCURR<1,1> THEN
             XCURR.RATE.GET NCURR<1,2>,TCURR<1,1>,NDATE
             TOP = OCONV(NCURR<1,2>,'MR4')
          END

          *** This is the ratio applied to all the LI prices/costs.
          XRATIO = TOP/BOT

          IQPRC    = ICONV(OCONV(IQPRC   * XRATIO,'MR9'),'MR9')
          IQ.COMM  = ICONV(OCONV(IQ.COMM * XRATIO,'MR9'),'MR9')
          IQ.COGS  = ICONV(OCONV(IQ.COGS * XRATIO,'MR9'),'MR9')

          RETURN
*-------------------------------------------------------------------------*
CHK.ORIG.LOCKS:*** Check original order locks.

          * Check if initial original order is locked.
          OOID = FIELD(INIT.ORIG.OID,'.',1)
          GOSUB CHK.OOID.LOCK
          IF ORIG.LOCKED THEN RETURN

          * Check if current original order is locked.
          OOID = FIELD(ORIG.OID,'.',1)
          GOSUB CHK.OOID.LOCK

          RETURN
*-------------------------------------------------------------------------*
CHK.OOID.LOCK:*** Check if the original order id (ooid) is locked.

          ORIG.LOCKED = NO
          IF OOID = '' OR OID = OOID THEN RETURN

          CHECK.RECORD.LOCK LEDFILE,OOID,IS.LOCKED,USER.LOCKED
          IF IS.LOCKED = YES AND USER.LOCKED = USER.ID THEN
             ORIG.LOCKED = YES
             UT.GET.PROMPT "%376":AM:OOID,LOCK.MSG
             CONVERT VM TO AM IN LOCK.MSG
             UT.GET.PROMPT "%103",PRESS.ENTER
             ERR.MESS ,,LOCK.MSG:AM:PRESS.ENTER,YES
          END

          RETURN
*-------------------------------------------------------------------------*
FILEIT:   *
          BEGIN CASE
          CASE VIEW.ONLY
             GOTO FINISH
          CASE F12 AND NO.IN.OE
             CONFIRM.ABORT SURE
             IF NOT(SURE) THEN
                GOTO IN.CHK
             END
             GOTO FINISH
          CASE F12
             DEL.RET = ''
             IPRMPT = 'Are you sure you want to abort? '
             IF ORIG.LDATA = '' THEN
                IPRMPT := AM:'This return item will be deleted. '
             END
             IPRMPT := '(Y/N) '
IN$$5:       INP.PROMPT DEL.RET,IPRMPT,'YN',1
             IF NOT(DEL.RET) THEN
                GOTO IN.CHK
             END ELSE
                * Initialize so line will be deleted in OE.ACTION.DISPLAY
                IF ORIG.LDATA = '' THEN
                   LD(7)<1,GEN> = ''
                END
                GOTO FINISH
             END
             IF REQ.CD = 1 THEN
                MESS 10,10,BELL:'Reason Code is required!'
                GOTO IN.CODE
             END
             MATPARSE LD FROM SAVE.LD
             OLD.LD(24) = LD(24)
          CASE OTHERWISE
             IF STK.TYP = '' THEN
                MESS 10,10,BELL:'Return Quantity Type is required!'
                GOTO IN.TYP
             END
             IF REQ.CD = 1 AND RCODE = '' THEN
                MESS 10,10,BELL:'Reason Code is required!'
                GOTO IN.CODE
             END

             * If the user hasn't entered an order and we should check
             * Inventory History, do so.
             IF ((TOID = "") AND CTO) THEN
                GOSUB INV.HIST
             END

             CONVERT ',' TO AM IN TST.TYPS
             LOCATE STK.TYP IN TST.TYPS SETTING TPOS ELSE
                PRINT BELL:
                GOTO IN.TYP
             END

             * Check authorization to determine if they are even authorized
             * for the return.
             GOSUB CHK.RETURN

             IF NOT(RETURN.ALLWD) THEN
                MATPARSE LD FROM SAVE.LD
                OLD.LD(24)   = LD(24)
                * Initialize so line will be deleted in OE.ACTION.DISPLAY
                IF (ORIG.OID # INIT.ORIG.OID) OR TYP.CHG THEN
                   LD(7)<1,GEN> = ''
                END
                GOTO FINISH
             END

             STK.BR = LED(2)<1,GEN,2>
             RET.LOC.PRI = ''
             IF LDATA THEN
                GOSUB GET.LINFO
                GOSUB UPD.WRTR
                GOSUB UPD.SRC

                IF STOP.DUP.RETURN THEN
                   GOSUB CHECK.QTYS.ALLOWED
                END

                IF LD2(1)#LD(1) THEN
                   MESS 10,10,BELL:'Component of Kit... Must be manually Priced!!'
IN$$1:             INP A,,,0

                   *** Make sure the amts of the returning component are
                   *** less than the component totals on the orig order.
                   COMP.TOT = 0
                   LD2.31.CT = DCOUNT(LD2(31),VM)
                   FOR L2 = 1 TO LD2.31.CT
                      IF LD2(31)<1,L2> # LD(1) THEN CONTINUE
                      IF LD2(39)<1,L2> THEN SPOIL = LD2(39)<1,L2> ELSE SPOIL = 0
                      MULT = 1 + (SPOIL/1000)
                      COMP.TOT += INT(-LD2(4) * LD2(30)<1,L2> * MULT)
                   NEXT L2
                   IF COMP.TOT < LD(4) THEN
                      VAR = ''
INCQT:                INP.PROMPT VAR,BELL:'WARNING!! Original Order Component Qty was ':COMP.TOT:' - Continue (Y/N) : ','YN',1
                      IF NOT(VAR) THEN GOTO IN.CHK
                   END
                END ELSE
                   * Warning is okay (see below) if we are allowing
                   * duplicate returns or if this is not a Sales Order.
                   WARN.OK = (NOT(STOP.DUP.RETURN) OR (MODE # "S"))

                   * If the return exceeds the original and we are not
                   * restricting duplicate returns, warn the user.
                   IF ((-LD2(4) < LD(4)) AND WARN.OK) THEN
                      VAR = ''
IN$$2:                INP.PROMPT VAR,BELL:'WARNING!! Original Order Qty was ':-LD2(4):' - Continue (Y/N) : ','YN',1
                      IF NOT(VAR) THEN GOTO IN.CHK
                   END
                   IF (ORIG.OID # INIT.ORIG.OID) THEN
                      *** If Kit Item, Bring over kit Data.
                      IF LD(30) THEN
                         LD(30) = LD2(30)
                         LD(31) = LD2(31)
                         LD(37) = LD2(37)
                         LD(38) = LD2(38)
                         LD(39) = LD2(39)
                      END
                      LD(15)<1,GEN> = ''

                      * Save tax jurisdiction/tax code if flagged to use
                      * original tax rate
                      IF USE.ORIG.TAX THEN
                         LD(90)           = LD2(90)
                         LED(79)<1,GEN>   = ORIG.TAX
                         TAX.COMMENT  = 'Control setting changed tax to '
                         TAX.COMMENT := LED(79)<1,GEN,1>
                         TAX.COMMENT := ' from original sale ':ORIG.OID
                         OE.ADD.COMMENT OID,GEN,TAX.COMMENT
                      END

                      PRC.DATA = ''

                      IQPRC    = LD2( 8)<1,GN>
                      IQ.COMM  = LD2(27)<1,GN>
                      IQ.COGS  = LD2(10)<1,GN>

                      NCURR    = RAISE(LED(92)<1,GEN>)
                      NDATE    = LED(22)<1,GEN>

                      GOSUB CHK.CURR
                      OVERRIDE = YES
                      OE.REPRICE.GENS OID,GEN,LDID,IQPRC,,QSIGN,OVERRIDE,'@@',PRC.ERROR
                      OVERRIDE = 3 ;* Flag as system override

                      OE.UPD.COMM.COST GEN,OVERRIDE,IQ.COMM
                      OE.UPD.COGS GEN,OVERRIDE,IQ.COGS

                      *** Pull F.E.T. from original order
                      LD(55)<1,GN> = LD2(55)<1,GEN>

                      * make sure we keep any sell group rebate info
                      * from the original order.
                      IF LD2(29)<1,GN,17> THEN
                         LD(29)<1,GEN,17> = LD2(29)<1,GN,17>
                         LD(29)<1,GEN,18> = LD2(29)<1,GN,18>
                      END
                   END

                   IF (STK.TYP#'S' AND RET.LOC.DFLT='') OR (STK.TYP='S' AND RET.LOC.SDFLT='') THEN
                      IF RET.LOC.COPY THEN
                         PRD.LOCATION.GET RET.LOC.PRI,LD(1),STK.BR,'P',,STK.TYP
                      END
                   END
                END

                * Remove prior original sales comments.
                GOSUB RMV.ORIG.CMTS

                LOCATE "1" IN LD(2)<1> SETTING CPOS ELSE
                   CPOS = DCOUNT(LD(2)<1>,VM)+1
                   LD(2)<1,CPOS> = "1"
                END
                LD(3)<1,CPOS,-1>='** Original Sale : ':TOID:'.':TINVN"R%3":' **'

                * Add original customer PO comment if original PO exists
                * and control record is set to yes
                IF ORIG.CUS.PO # '' THEN
                   CTRB.ID = "SOE.RETURN.PO.COMMENTS~":STK.BR
                   READV RET.PO.CMT FROM CTRBFILE,CTRB.ID,1 ELSE
                      RET.PO.CMT = ''
                   END
                   IF RET.PO.CMT THEN
                      LD(3)<1,CPOS,-1> = '** Cus PO: ':ORIG.CUS.PO:' **'
                   END
                END

*** Load the original sales data into LD(44) through LD(46)
*** Also load the serial number they chose into the LD(32)<1,GEN> if I.
                PRD.BR.GET.VAL LED(2)<1,GEN,2>,LD(1),25,GRP
                IF GRP='I' OR GRP='A' OR GRP='D' THEN
                   IF LD(32)<1,GEN> = '' THEN
                      LD(32)<1,GEN> = SER.NUM
                   END
                END

                LD(44) = TOID:'.':TINVN:'.':TLDID:'.':STK.TYP:'.':TLOC

                CMT = '** Returned Item : ':OID:' - Prod Desc : ':PRD(1)<1,1>:' -Qty : ':SUM(LD(5)<1,GEN>)+SUM(LD(6)<1,GEN>)
*** Set LED to the original order for comment update and then put back
                MATBUILD SVLED FROM LED
                MATREAD LED FROM LEDFILE,TOID ELSE MAT LED = ''
                OE.ADD.COMMENT TOID,GN,CMT
                MATPARSE LED FROM SVLED
             END ELSE
                IF REQUIRE.ORIG THEN
                   KEY.REQD = "SOE.RETURN.ALLOWED"
                   PROMPT   = "bypass entering a required original order!"

                   * Only need level 1 auth for stock items.
                   IF STAT = 1 THEN LVL.REQD = 1 ELSE LVL.REQD = 2
                   OE.GET.AUTH OID,PROMPT,KEY.REQD,ACTION.OK,,,LVL.REQD
                   IF NOT(ACTION.OK) THEN
                      GOTO IN.CHK
                   END
                END
                LD(44) = '...':STK.TYP

                * Remove prior original sales comments.
                GOSUB RMV.ORIG.CMTS
             END

             GOSUB UPDATE.ORIG.QTYS

             LD(99)<1,1> = RPRC      ;* Update restocking price percentage
             LD(99)<1,2> = LD(4)     ;* Update restocking qty

             FOLD COMMENT,'35',CMT2,''
             LD(45) = CMT2
             LD(46) = RCODE

             GEN.MV = GEN
             IF (ORIG.OID = INIT.ORIG.OID) AND NOT(TYP.CHG) AND STK.TYP = FIELD(LD(7)<1,GEN>,'~',1) THEN
                NULL; * No need to go through location updates
             END ELSE
                OLD.LOT = ''
                PRD.BR.GET.VAL LED(2)<1,GEN,2>,LD(1),11,LCTRL
                LOC.IDS = ''
                RET.QTYS = ''
                ** If the product is lot controled, then get the old lot.
                IF LCTRL = 'D' OR LCTRL = 'L' THEN
                   LD.READ MAT OLD.LD2,TOID,TLDID

                   READV INVS FROM LEDFILE,TOID,8 ELSE INVS = ''
                   LOCATE TINVN IN INVS<1> SETTING TGEN ELSE TGEN = ''

                   IF TGEN # '' AND OLD.LD2(7)<1,TGEN,1> # '' THEN
                      IF DCOUNT(OLD.LD2(7)<1,GEN>,SVM) > 1 THEN
                         GOSUB GET.LOT.RET.QTY
                      END ELSE
                         LOC.IDS  = OLD.LD2(7)<1,GEN>
                         RET.QTYS = SUM(LD(5)<1,GEN>) + SUM(LD(6)<1,GEN>)
                      END
                   END ELSE
                      RET.QTYS = SUM(LD(5)<1,GEN>) + SUM(LD(6)<1,GEN>)
                   END
                END
                UPD.COMP = NO
                TP.CT  = DCOUNT(LD(7)<1,GEN>,SVM)
                IF DCOUNT(LOC.IDS,VM) > TP.CT THEN
                   TP.CT = DCOUNT(LOC.IDS,VM)
                END
                FOR TN = 1 TO TP.CT
                   TYP     = FIELD(LD(7)<1,GEN,TN>,'~',1)
                   QTY     = RET.QTYS<1,TN> + 0
                   IF QTY = 0 THEN
                      QTY = LD(5)<1,GEN,TN> + LD(6)<1,GEN,TN>
                   END

                   FLOC    = LOC.IDS<1,TN>
                   IF TRIM(FLOC) = '' THEN
                      FLOC = LD(7)<1,GEN,TN>
                   END
                   FLOC    = FIELD(FLOC,'~',2)
                   OLD.LOC = FIELD(FLOC,'|',1)
                   OLD.LOT = FIELD(FIELD(FIELD(FLOC,'|',2),'@',1),'^',1)
                   LD(5)<1,GEN,TN> = ''
                   LD(6)<1,GEN,TN> = ''
                   IF INDEX(STK.TYPES.AVL$,STK.TYP[1,1],1) THEN
                      LD(5)<1,GEN,TN> = QTY
                   END ELSE
                      LD(6)<1,GEN,TN> = QTY
                   END
                   NLOC = FIELD(LD(7)<1,GEN,TN>,'~',2,999)
                   IS.ENABLED = NO
                   LOC.DB.BR.ENABLED STK.BR,IS.ENABLED
                   IF NOT(IS.ENABLED) THEN
                      BEGIN CASE
                      CASE STK.TYP[1,1] = 'C'; NULL
                      CASE STK.TYP = 'S' AND RET.LOC.SDFLT AND LED(110)<1,1> # 'S'
                         NLOC = RET.LOC.SDFLT
                         UPD.COMP = YES
                      CASE STK.TYP # 'S' AND RET.LOC.DFLT
                         NLOC = RET.LOC.DFLT
                         UPD.COMP = YES
                      END CASE
                   END
                   NEW.LOC = STK.TYP:'~':NLOC
                   IF TYP.CHG OR NOT(ORIG.TYP) THEN
                      LD(7)<1,GEN,TN> = NEW.LOC
                   END
                   *** If all the flags are set properly, copy over the
                   *** to the return item.
                   IF RET.LOC.PRI THEN
                      OTAG = FIELD(LD(7)<1,GEN,TN>,'^',2)
                      OLOC = FIELD(FIELD(LD(7)<1,GEN,TN>,'~',2),'^',1)
                      OTYP = FIELD(FIELD(LD(7)<1,GEN,TN>,'~',1),'^',1)
                      OLOT = FIELD(OLOC,'|',2)
                      OLOC = FIELD(OLOC,'|',1)

                      NEW.LOC  = OTYP:'~':RET.LOC.PRI
                      IF OLOT THEN
                         NEW.LOC = FIELDSTORE(NEW.LOC,'|',2,1,OLOT)
                      END
                      IF OTAG THEN
                         NEW.LOC = FIELDSTORE(NEW.LOC,'^',2,1,OTAG)
                      END
                      IF TYP.CHG OR NOT(ORIG.TYP) THEN
                         LD(7)<1,GEN,TN> = NEW.LOC
                      END
                   END

                   IF OLD.LOT THEN
                      NLOC            = LD(7)<1,GEN,TN>
                      NTYP            = FIELD(NLOC,'~',1)
                      NLOC            = FIELD(NLOC,'~',2)
                      NLOT            = FIELD(NLOC,'|',2)
                      NLOC            = FIELD(NLOC,'|',1)

                      *** If user did not specify a new location, use old loc
                      IF NOT(NLOC) THEN NLOC = OLD.LOC

                      NLOC            = NTYP:'~':NLOC:'|':OLD.LOT
                      LD(7)<1,GEN,TN> = NLOC
                   END
                NEXT TN
                IF STK.TYP = 'D' AND TP.CT > 1 THEN
                   LD(7)<1,GEN> = LD(7)<1,GEN,1>
                   LD(6)<1,GEN> = SUM(LD(5)<1,GEN>) + SUM(LD(6)<1,GEN>)
                   LD(5)<1,GEN> = ''
                END

                NUM.CMP = DCOUNT(LD(31),VM)
                FOR CTR = 1 TO NUM.CMP
                   KIT.QTY  = SUM(LD(5)<1,GEN>) + SUM(LD(6)<1,GEN>)
                   LD(93)<1,CTR,GEN> = LD(30)<1,CTR> * KIT.QTY
                   BEGIN CASE
                   CASE UPD.COMP
                      LD(94)<1,CTR,GEN> = LD(7)<1,GEN>
                   CASE OTHERWISE
                      COMP.LOCS = RAISE(LD(94))
                      LOCA     = FIELD(COMP.LOCS<CTR,GEN,1>,'~',2)
                      KIT.TYPE = FIELD(LD(7)<1,GEN>,'~',1)
                      COMP.LOCS<CTR,GEN,1> = KIT.TYPE:'~':LOCA
                      LD(94) = LOWER(COMP.LOCS)
                   END CASE
                NEXT CTR

                *** Prorate return if neccissary
                TREAD.PRORATE LD(1),GEN
                ***  Bring over return comments
                IF LD(68) THEN
                   READV ORIG.DEP FROM PRDFILE,LD(1),103 ELSE ORID.DEP = ''
                   LOCATE "1" IN LD(2)<1> SETTING CPOS ELSE
                      CPOS = DCOUNT(LD(2)<1>,VM)+1
                      LD(2)<1,CPOS> = "1"
                   END
                   LD(3)<1,CPOS,-1>='** Return Percent: ':OCONV(LD(58)<1,GEN>,'MR2'):'%'
                   LD(3)<1,CPOS,-1>='** Original Depth: ':OCONV(ORIG.DEP,'MR1'):'/32'
                   LD(3)<1,CPOS,-1>='** Remaining Depth: ':OCONV(LD(68)<1,GEN>,'MR1'):'/32'
                END

             *** Copy over credit card inforamtion from original order
                OOID = FIELD(ORIG.OID,'.',1)
                IF TRIM(OOID) # "" THEN
                   CREDIT.CARD.GET.CC.RECS OOID,YES,ELEMENT.CARDS
                   LED(146) = LOWER(ELEMENT.CARDS)
                   IF LED(121)<1,17>[1,2] # 'L~' THEN
                      READV CCDATA FROM LEDFILE,OOID,121 ELSE CCDATA = ''
                      IF CCDATA<1,17>[1,2] = 'L~' THEN
                         *Pretend that there is no cc data on the old order
                         CCDATA = ''
                         CLEAR.LEDCC = YES
                      END
                      IF CCDATA AND NOT(LCC.ERR) THEN
                         READ ECCDATA FROM LEDCCFILE,OOID ELSE ECCDATA = ''
                         IF ECCDATA<3> THEN
                            CREDIT.CARD.CHECK.EXP.DT ECCDATA<3>,EXP.ERR
                            IF EXP.ERR THEN
                               *Do not copy data for an expired card
                               CCDATA = ''
                               CLEAR.LEDCC = YES
                            END
                         END
                      END
                      LED(121) = CCDATA
                      COPY.LEDCC = YES
                   END
                END

                * Find the current auth type and see if it is
                * "Authorize Only Before Shipment" (1). If it is, then
                * change to "Sale Before Shipment" (2) as "Authorize only"
                * will not work on a return
                IF LED(121)<1,7> = 1 THEN LED(121)<1,7> = 2
             END

             * Need to save any UET logs against this item so that user
             * is not prompted again for UET code
             SV.UET.DATA = ''
             UCNT = DCOUNT(LD(24),VM)
             FOR U = 3 TO UCNT
                SV.UET.DATA<1,-1> = LD(24)<1,U>
             NEXT U

             LD(24) = OID:VM:LDID
             IF SV.UET.DATA THEN
                LD(24) = LD(24):VM:SV.UET.DATA
             END
             OLD.LD(24) = LD(24)

             * Save Credit/Rebill info
             LD(120) = OLD.LD(120)

             UPDATE.LEDGER.DET OID,LDID,'-1',GEN.MV
             GOSUB CHK.RSTK.FEE
             UPDATE.LEDGER OID,GEN.MV
             IF COPY.LEDCC AND NOT(LCC.ERR) AND OID # OOID AND OOID THEN
                READU NLCCREC FROM LEDCCFILE,OID THEN
                   DO.WRITE = YES
                   *If the current LEDGER.CC record exists, it must be
                   *preserved even if the LED(121) data is being cleared
                   *because it may also contain data for LED(46)
                END ELSE
                   NLCCREC = ''
                   DO.WRITE = NO
                END
                IF CLEAR.LEDCC THEN OLCCREC = ''
                ELSE
                   READ OLCCREC FROM LEDCCFILE,OOID THEN DO.WRITE = YES
                   ELSE OLCCREC = ''
                END
                NLCCREC = FIELDSTORE(NLCCREC,AM,1,15,OLCCREC);
                *Only copy fields 1 to 15 as these correspond to the LED(121)
                *data. Other data correspons to LED(46)
                IF DO.WRITE THEN
                   WRITE NLCCREC ON LEDCCFILE,OID
                END ELSE
                   RELEASE LEDCCFILE,OID
                END
             END
          END CASE
          GOTO FINISH
*-------------------------------------------------------------------------*
RMV.ORIG.CMTS:*** Remove prior original sales comments.

          CTYP.CT = DCOUNT(LD(2)<1>,VM)
          FOR CT.LN = 1 TO CTYP.CT
             CMT.CT = DCOUNT(LD(3)<1,CT.LN>,SVM)
             FOR JT = CMT.CT TO 1 STEP -1
                CMT = LD(3)<1,CT.LN,JT>
                BEGIN CASE
                CASE CMT[1,18]='** Original Sale :'
                   LD(3) = DELETE(LD(3),1,CT.LN,JT)
                CASE CMT[1,18]='** Return Percent:'
                   LD(3) = DELETE(LD(3),1,CT.LN,JT)
                CASE CMT[1,18]='** Original Depth:'
                   LD(3) = DELETE(LD(3),1,CT.LN,JT)
                CASE CMT[1,18]='** Remaining Depth'
                   LD(3) = DELETE(LD(3),1,CT.LN,JT)
                CASE CMT[1,10]='** Cus PO:'
                   LD(3) = DELETE(LD(3),1,CT.LN,JT)
                END CASE
             NEXT JT
          NEXT CT.LN

          RETURN
*-------------------------------------------------------------------------*
FINISH:   QUIT = NO
          F12  = NO
          MOVE = 0
          LASTKEY = 0
          WINDOW.CLOSE
          RETURN
*-------------------------------------------------------------------------*
CHECK.QTYS.ALLOWED: *** Check to see if the original order is able to
          *** return the quantity on this order. If not, throw an error
          *** and do not let the user continue.

          ORIG.ORD      = TOID:".":TINVN:".":TLDID:".":STK.TYP:".":TLOC
          RET.ERROR.MSG = ""

          * Check to see if there was already a return order for
          * this item. If not...
          IF (INIT.ORIG.OID = "") THEN
             NEW.RET.QTY = SUM(LD(5)<1,GEN>) + SUM(LD(6)<1,GEN>)
             SOE.RETURN.CHECK.QTYS OID,GEN,LDID,,NEW.RET.QTY,ORIG.ORD,RET.ERROR.MSG

          * Changing the original order...
          END ELSE
             * If the order has been changed, we will see if we can
             * proceed with the change.
             IF (INIT.ORIG.OID # ORIG.OID) THEN
                NEW.RET.QTY = SUM(LD(5)<1,GEN>) + SUM(LD(6)<1,GEN>)
                SOE.RETURN.CHECK.QTYS OID,GEN,LDID,,NEW.RET.QTY,ORIG.ORD,RET.ERROR.MSG
             END
          END

          IF RET.ERROR.MSG THEN
             * See if the user is allowed to return against an order that
             * has reached/exceeded its return limit.
             KEY.REQD = "SOE.RETURN.ALLOWED"
             PROMPT   = RET.ERROR.MSG

             * Only need level 1 auth for stock items.
             IF STAT = 1 THEN LVL.REQD = 1 ELSE LVL.REQD = 2
             OE.GET.AUTH OID,PROMPT,KEY.REQD,ACTION.OK,,,LVL.REQD
             IF NOT(ACTION.OK) THEN
                RETURN TO IN.CHK
             END
          END

          RETURN
*-------------------------------------------------------------------------*
UPDATE.ORIG.QTYS: *** Update the quantities that have been returned on
          *** the original orders.

          ORIG.ORD    = LD(44)
          NEW.RET.QTY = SUM(LD(5)<1,GEN>) + SUM(LD(6)<1,GEN>)

          * If this is a existing return and we are changing the original
          * order, we need to update the quantities returned on both the
          * old original order and new original order.
          IF ((INIT.ORIG.OID # "") AND (INIT.ORIG.OID # ORIG.OID)) THEN
             * Update the old original order with the quantity and then
             * Update the new original order with the quantity.
             SOE.RETURN.UPD.QTYS OID,GEN,LDID,INIT.ORIG.ORD,ORIG.ORD,0,NEW.RET.QTY
          END ELSE IF (INIT.ORIG.OID = "") THEN
             * Update the newly specified original order with the
             * quantity.
             SOE.RETURN.UPD.QTYS OID,GEN,LDID,,ORIG.ORD,0,NEW.RET.QTY
          END

          RETURN
*-------------------------------------------------------------------------*
CHK.RSTK.FEE: *** Update restocking fee.

          IF NOT(RSTK.PN) THEN RETURN

          * Get old restock price
          OLD.RPRC = SAVE.LD<99,1>
          IF OLD.RPRC THEN
             OLD.QTY     = SAVE.LD<99,2>
             OLD.STK.PRC = (SAVE.LD<8,GEN>*OLD.RPRC/100) * OLD.QTY
          END ELSE
             OLD.STK.PRC = ''
          END

          * If no new or old restock % return there's nothing to update
          IF NOT(RPRC) AND NOT(OLD.RPRC) THEN RETURN

          MAT SV.CURR.LD = MAT LD
          MAT SV.OLD.LD  = MAT OLD.LD
          CURR.PRC       = LD(8)<1,GEN>
          CURR.QTY       = LD(4)

          CURR.LDID  = LDID
          FOUND.LDID = ''
          LDIDS      = RAISE(LED(48)<1,GEN>)
          LDID.CT    = DCOUNT(LDIDS,VM)
          FOR LDN = 1 TO LDID.CT
             LDID = LDIDS<1,LDN>
             LD.GET LDID
             * Determine if there is a restocking charge item on gen
             IF LD(1) = RSTK.PN THEN
                FOUND.LDID = LDID
                EXIT
             END
          NEXT LDN

          IF NOT(FOUND.LDID) THEN
             GOSUB CREATE.RSTK.PN
          END ELSE
             GOSUB ADD.NEW.CHG
          END

          GOSUB RELOAD.CUR.LDID     ;* re-activate the credit item
          REDISP      = YES         ;* redisplay from calling program

          RETURN
*-------------------------------------------------------------------------*
CHK.RETURN:  * Checks to see if the return can be made. It will check to
             * see if the return type is allowed and if not will then check
             * the number of days allowed for a return. If we are past the
             * days allowed, authorization will be checked.

          TYPE.ALLWD   = NO
          RETURN.ALLWD = YES

          STAT = PRD(3)

          * Returns are only checked for stock,nonstock delete or purges.
          IF STAT # 1 AND STAT # 2 AND STAT # 4 AND STAT # 7 THEN RETURN

          * Check to see if the return type is one that can be returned
          * at anytime.
          CRTL.ID = "RETURN.TYPES.ALLOWED"
          READ RTRN.TYPS FROM CTRLFILE,CRTL.ID ELSE RTRN.TYPS =''

          LOCATE STK.TYP IN RTRN.TYPS<1> SETTING NADA THEN TYPE.ALLWD = YES

          * If the return type is not one that can be returned at
          * anytime,check the maximum days a return can happen and then
          * authorization if necessary.
          IF NOT(TYPE.ALLWD) THEN
             * Checks to see if the return is within the return
             * timeframe.
             STK.BR      = LED(2)<1,GEN,2>
             IF STAT     = 1 THEN
                CTRB.ID  = "MAX.DAYS.RETURN.STK~":STK.BR
             END ELSE
                CTRB.ID  = "MAX.DAYS.RETURN.NSTK~":STK.BR
             END

             READV MAX.DAYS FROM CTRBFILE,CTRB.ID,1 ELSE MAX.DAYS = ''

             * Leave if there is no original order for the return.
             IF ORIG.OID  = '' THEN RETURN

             RETURN.ALLWD = NO

             IF MAX.DAYS # '' THEN
                * Get the ship date of the original order.
                O.OID  = FIELD(ORIG.OID,'.',1)
                O.INVN = FIELD(ORIG.OID,'.',2)+0
                MATBUILD SVLED FROM LED
                MATREAD LED FROM LEDFILE,O.OID ELSE MAT LED = ''
                LOCATE O.INVN IN LED(8)<1> SETTING O.GEN ELSE O.GEN = 1
                SHP.DATE = LED(9)<1,O.GEN>
                MATPARSE LED FROM SVLED

                DAYS.BTWN = DATE() - SHP.DATE

                IF DAYS.BTWN < MAX.DAYS AND MAX.DAYS # 0 THEN
                   RETURN.ALLWD = YES
                END ELSE
                   * If outside of the return timeframe, look at the auth
                   * for the user.
                   KEY.REQD = 'SOE.RETURN.ALLOWED'

                   PROMPT = "Make a Return After the Maximum "
                   PROMPT:= "Days Allowed"

                   * Only need level 1 auth for stock items.
                   IF STAT = 1 THEN LVL.REQD = 1 ELSE LVL.REQD = 2
                   OE.GET.AUTH OID,PROMPT,KEY.REQD,ACTION.OK,,,LVL.REQD
                   IF ACTION.OK THEN RETURN.ALLWD = YES
                END
             END ELSE
                RETURN.ALLWD = YES
             END
          END

          RETURN
*-------------------------------------------------------------------------*
CREATE.RSTK.PN: *** this is the first restock fee and therefore we need
                *** to add the restock product to the order

          MAT LD     = ''
          MAT OLD.LD = ''
          PN         = RSTK.PN
          QTY        = 1
          PRC.BR     =  LED(2)<1,GEN,1>
          OE.NEW.LDID OID,LDID
          GOSUB LOAD.PN

          GEN.MV = GEN
          UPDATE.LEDGER.DET OID,LDID,QSIGN,GEN.MV

          RETURN
*-------------------------------------------------------------------------*
*** Load all product information into the LD array
LOAD.PN:  *
          LD(1) = PN
          OE.GET.PN.FULL OID,GEN,PRC.BR,PN,LDID,QSIGN

          LD(4)     = QTY * QSIGN
          DFLT.PER.GET MODE,,DFLT.ALPHA
          IF LD(23) = '' THEN
             LD(23) = DFLT.ALPHA
             READ ORD.UOM FROM CTRLFILE,'OE.USE.ORDER.UOM' ELSE ORD.UOM=''
             IF ORD.UOM THEN
                LD(85) = DFLT.ALPHA
             END
          END

          LD(5)<1,GEN> = QTY * QSIGN
          LD(7)<1,GEN> = 'S~'

          OE.PRICE.ITEM OID,GEN,LDID,PN,QTY,QSIGN

          IQPRC    = (CURR.PRC*RPRC/100)* CURR.QTY
          OVERRIDE = YES
          OE.REPRICE.GENS OID,GEN,LDID,IQPRC,,QSIGN,OVERRIDE,'@@'

          RETURN
*-------------------------------------------------------------------------*
ADD.NEW.CHG:  *** Add the new restocking charges to the charges that
              *** are already there.

          LD.GET FOUND.LDID
          MAT OLD.LD  = MAT LD
          OE.GET.QSIGN QSIGN,OID,GEN
          GET.ALL.PRD BR,LD(1),QSIGN,''
          STK.PRC     = LD(8)<1,GEN>
          IF OLD.STK.PRC THEN
             STK.PRC -= OLD.STK.PRC
          END
          IQPRC       = STK.PRC + ((CURR.PRC*RPRC/100)* CURR.QTY)
          OVERRIDE    = YES
          OE.REPRICE.GENS OID,GEN,FOUND.LDID,IQPRC,,QSIGN,OVERRIDE,'@@'
          GEN.MV      = GEN
          UPDATE.LEDGER.DET OID,FOUND.LDID,QSIGN,GEN.MV

          *** Restore LD and PRD arrays for the LDID
          LD.GET LDID
          GET.ALL.PRD BR,LD(1),QSIGN,''

          RETURN
*-------------------------------------------------------------------------*
RELOAD.CUR.LDID: *** set up the current LDID after adding the restocking
                 *** product

          LDID        = CURR.LDID
          LD.GET LDID

          MAT LD      = MAT SV.CURR.LD
          MAT OLD.LD  = MAT SV.OLD.LD

          RETURN
*-------------------------------------------------------------------------*
!TSMITH~03/30/17~14:37
